home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / reserv.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  5.8 KB  |  195 lines
  1. /* reserv.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  26.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  27. } flags_;
  28.  
  29. #define flags_1 flags_
  30.  
  31. struct {
  32.     doublereal value[200000];
  33. } blank_;
  34.  
  35. #define blank_1 blank_
  36.  
  37. /* Table of constant values */
  38.  
  39. static integer c__1 = 1;
  40.  
  41. /*<       subroutine reserv (node1,node2) >*/
  42. /* Subroutine */ int reserv_(node1, node2)
  43. integer *node1, *node2;
  44. {
  45.     /* System generated locals */
  46.     integer i_1;
  47.  
  48.     /* Local variables */
  49.     static integer loci, locj, isize;
  50. #define nodplc ((integer *)&blank_1)
  51. #define cvalue ((complex *)&blank_1)
  52.     extern logical memptr_();
  53.     extern /* Subroutine */ int sizmem_();
  54.     static integer newloc;
  55.     extern /* Subroutine */ int extmem_();
  56.     static integer loc;
  57.  
  58. /*<       implicit double precision (a-h,o-z) >*/
  59.  
  60. /*     this routine records the fact that the (node1, node2) element of */
  61.  
  62. /* the circuit equation coefficient matrix is nonzero. */
  63.  
  64. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  65. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  66. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  67. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  68. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  69. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  70. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  71. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  72. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  73. /* spice version 2g.6  sccsid=flags 3/15/83 */
  74. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  75. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  76. /* spice version 2g.6  sccsid=blank 3/15/83 */
  77. /*<       common /blank/ value(200000) >*/
  78. /*<       integer nodplc(64) >*/
  79. /*<       complex cvalue(32) >*/
  80. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  81.  
  82. /*<       logical memptr >*/
  83.  
  84. /*<       if (nogo.ne.0) go to 300 >*/
  85.     if (flags_1.nogo != 0) {
  86.     goto L300;
  87.     }
  88. /* ...  test for ground */
  89. /*<       if (node1.eq.1) go to 300 >*/
  90.     if (*node1 == 1) {
  91.     goto L300;
  92.     }
  93. /*<       if (node2.eq.1) go to 300 >*/
  94.     if (*node2 == 1) {
  95.     goto L300;
  96.     }
  97.  
  98. /*     reserve (node1,node2) in row node1 at col posn node2 */
  99.  
  100. /*<       loc=node1 >*/
  101.     loc = *node1;
  102. /*<    10 locj=loc >*/
  103. L10:
  104.     locj = loc;
  105. /*<       loc=nodplc(jcpt+loc) >*/
  106.     loc = nodplc[tabinf_1.jcpt + loc - 1];
  107. /*<       if (loc.eq.0) go to 20 >*/
  108.     if (loc == 0) {
  109.     goto L20;
  110.     }
  111. /*<       if (nodplc(jcolno+loc)-node2) 10,300,20 >*/
  112.     if ((i_1 = nodplc[tabinf_1.jcolno + loc - 1] - *node2) < 0) {
  113.     goto L10;
  114.     } else if (i_1 == 0) {
  115.     goto L300;
  116.     } else {
  117.     goto L20;
  118.     }
  119. /*<    20 call sizmem(jcpt,isize) >*/
  120. L20:
  121.     sizmem_(&tabinf_1.jcpt, &isize);
  122. /*<       newloc=isize+1 >*/
  123.     newloc = isize + 1;
  124. /*<       nodplc(numoff+node1)=nodplc(numoff+node1)+1 >*/
  125.     ++nodplc[tabinf_1.numoff + *node1 - 1];
  126. /*<       nodplc(nmoffc+node2)=nodplc(nmoffc+node2)+1 >*/
  127.     ++nodplc[tabinf_1.nmoffc + *node2 - 1];
  128. /*<       call extmem(jcpt,1) >*/
  129.     extmem_(&tabinf_1.jcpt, &c__1);
  130. /*<       call extmem(jcolno,1) >*/
  131.     extmem_(&tabinf_1.jcolno, &c__1);
  132. /*<       nodplc(jcpt+locj)=newloc >*/
  133.     nodplc[tabinf_1.jcpt + locj - 1] = newloc;
  134. /*<       nodplc(jcpt+newloc)=loc >*/
  135.     nodplc[tabinf_1.jcpt + newloc - 1] = loc;
  136. /*<       nodplc(jcolno+newloc)=node2 >*/
  137.     nodplc[tabinf_1.jcolno + newloc - 1] = *node2;
  138.  
  139. /*     reserve (node1,node2) in col node2 at row posn node1 */
  140.  
  141. /*<       loc=node2 >*/
  142.     loc = *node2;
  143. /*<    30 loci=loc >*/
  144. L30:
  145.     loci = loc;
  146. /*<       loc=nodplc(irpt+loc) >*/
  147.     loc = nodplc[tabinf_1.irpt + loc - 1];
  148. /*<       if (loc.eq.0) go to 40 >*/
  149.     if (loc == 0) {
  150.     goto L40;
  151.     }
  152. /*<       if (nodplc(irowno+loc)-node1) 30,300,40 >*/
  153.     if ((i_1 = nodplc[tabinf_1.irowno + loc - 1] - *node1) < 0) {
  154.     goto L30;
  155.     } else if (i_1 == 0) {
  156.     goto L300;
  157.     } else {
  158.     goto L40;
  159.     }
  160. /*<    40 call extmem(irpt,1) >*/
  161. L40:
  162.     extmem_(&tabinf_1.irpt, &c__1);
  163. /*<       call extmem(irowno,1) >*/
  164.     extmem_(&tabinf_1.irowno, &c__1);
  165. /*<       nodplc(irpt+loci)=newloc >*/
  166.     nodplc[tabinf_1.irpt + loci - 1] = newloc;
  167. /*<       nodplc(irpt+newloc)=loc >*/
  168.     nodplc[tabinf_1.irpt + newloc - 1] = loc;
  169. /*<       nodplc(irowno+newloc)=node1 >*/
  170.     nodplc[tabinf_1.irowno + newloc - 1] = *node1;
  171.  
  172. /*     mark diagonal */
  173.  
  174. /*<       if (node1.ne.node2) go to 300 >*/
  175.     if (*node1 != *node2) {
  176.     goto L300;
  177.     }
  178. /*<       if (memptr(ndiag)) nodplc(ndiag+node1)=1 >*/
  179.     if (memptr_(&tabinf_1.ndiag)) {
  180.     nodplc[tabinf_1.ndiag + *node1 - 1] = 1;
  181.     }
  182.  
  183. /*     finished */
  184.  
  185. /*<   300 return >*/
  186. L300:
  187.     return 0;
  188. /*<       end >*/
  189. } /* reserv_ */
  190.  
  191. #undef cvalue
  192. #undef nodplc
  193.  
  194.  
  195.